home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 19 / oaspro41.zip / POLLSEL.INC next >
Text File  |  1987-03-28  |  11KB  |  274 lines
  1. {--------------------------------------------------------------
  2. These routines can be used to emulate a terminal in a
  3. Poll Select (multipoint) environment.
  4. ---------------------------------------------------------------}
  5. const
  6.   tx_buffers  = 4;   {nr of xmit buffers; minimum = 1}
  7.   rx_buffers  = 4;   {nr of receive buffers; minimum = 1}
  8.   dc_addr_1 : byte = $33;  {first byte of terminal address}
  9.   dc_addr_2 : byte = $31;  {second byte of terminal address}
  10.  
  11. type
  12.   buffer_data = array[1..dc_buffer_size] of byte;
  13.   buffer_type = record     {description of rx and tx buffers}
  14.                   len :integer;  {length of data in buffer}
  15.                   data:buffer_data;
  16.                 end;
  17.   rx_buffer_type= array[0..rx_buffers] of buffer_type;
  18.   tx_buffer_type= array[0..tx_buffers] of buffer_type;
  19.  
  20. var
  21.   rx_buffer_overflow:boolean;   {rx data > buffersize}
  22.   rx_buffer:rx_buffer_type;
  23.   tx_buffer:tx_buffer_type;
  24.   result_ok:boolean;
  25.   ch_code:integer;
  26.   state:integer;    {used in poll select state machine}
  27.   rx_buff_wptr,     {rx buffer to be filled next}
  28.   rx_buff_rptr,     {rx buffer to be read next}
  29.   tx_buff_wptr,     {tx buffer to be sent last}
  30.   tx_buff_rptr   : integer;  {tx buffer to be sent first}
  31.   this_char_done:boolean;    {used in poll select state machine}
  32.   DC_msg_header:string255;
  33.   cont_string:string255;
  34.   char_ind:integer;
  35.   ok : boolean;
  36.   head_bcc:integer;
  37.  
  38. Procedure ps_handler;       {poll select state machine. run as }
  39.   begin;                    {background task}
  40.     if this_char_done then  {previous character finished}
  41.       receive_char(ch_code,ok); {get next char from dc rx buffer}
  42.       if ok then                {there was a character}
  43.       begin;
  44.         this_char_done:=true;   {preset}
  45.         case state of
  46.         0:If ch_code = eot then state:=1;  {eot received}
  47.         1:if ch_code = dc_addr_1 then    {first byte of address}
  48.             state:=2                     {wait for second byte}
  49.           else
  50.             state:=0;                   {reset state machine}
  51.         2:if ch_code = dc_addr_2 then   {second byte of address}
  52.             state:=3                    {wait for cntrl char}
  53.           else state:=0;                {reset state machine}
  54.         3:if ch_code = pol then state:=4 else {poll string}
  55.           if ch_code = sel then state:=7 else {select string}
  56.           if ch_code = fsl then state:=15 else {fast sel}
  57.             state:=0;       {otherwise reset state machine}
  58.         4:if ch_code = enq then   {end of string}
  59.             begin;
  60.               this_char_done:=false;  {dont read next char}
  61.               state:=5                {next is state = 5}
  62.             end
  63.           else
  64.             state:=0;                 {reset state machine}
  65.         5:if tx_buffer[tx_buff_rptr].len = 0 then
  66.             begin;                    {no data to send}
  67.               send_char(eot,ok);      {send eot}
  68.               state:=0;       {..and reset state machine}
  69.             end
  70.           else               {there is data to be sent}
  71.             begin;           {send it with header and bcc}
  72.               send_buffer(tx_buffer[tx_buff_rptr].data,
  73.                           1,tx_buffer[tx_buff_rptr].len,head_bcc,
  74.                           DC_msg_header,ok);
  75.               if ok then     {successfully sent}
  76.                 state:=6     {wait for ack}
  77.               else
  78.                 state:=0;    {otherwise reset state machine}
  79.             end;
  80.         6:begin;
  81.             if ch_code = ack then  {ack received}
  82.               begin;
  83.                 send_char(eot,ok); {send eot}
  84.                 if ok then         {successfully sent}
  85.                   begin;    {clear buffer & increase pointer}
  86.                     tx_buffer[tx_buff_rptr].len:=0;
  87.                     tx_buff_rptr:=succ(tx_buff_rptr) mod tx_buffers;
  88.                   end;
  89.                 state:=0;      {reset state machine}
  90.               end
  91.             else
  92.             if ch_code = nak then {mainframe didnt receive ok}
  93.               begin;              {resend data}
  94.                 this_char_done:=false;
  95.                 state:=5;
  96.               end
  97.             else                  {mainframe did not respond}
  98.               state:=0;           {reset state machine}
  99.           end;
  100.         7: if ch_code = enq then  {end of sel string}
  101.             begin;
  102.               this_char_done:=false; {dont receive next char}
  103.               state:=8;              {answer}
  104.             end
  105.           else
  106.             state:=0;                {reset state machine}
  107.        8: if rx_buffer[rx_buff_wptr].len > 0 then
  108.             begin;         {we have no rx buffer available}
  109.               send_char(nak,ok);     {send nak}
  110.               state:=0;              {reset state machine}
  111.             end
  112.           else        {we can receive data}
  113.             begin;
  114.               send_char(ack,ok);  {send ack}
  115.               if ok then state:=9 else   {ack could be sent}
  116.                 state:=0;  {otherwise reset state machine}
  117.             end;
  118.        9: if ch_code = soh then
  119.             state:=10      {SOH received}
  120.           else state:=0;
  121.       10: if ch_code = dc_addr_1 then  {first byte of address}
  122.             state:=11
  123.           else state:=0;
  124.       11: if ch_code = dc_addr_2 then
  125.             state:=12  {second byte of address received}
  126.           else state:=0;
  127.       12: begin;
  128.             if ch_code = stx then    {stx received}
  129.               begin;
  130.                 bcc:=stx xor head_bcc; {start bcc calculation}
  131.                 char_ind:=1;       {init rx buffer}
  132.                 state:=13;         {rx data}
  133.               end
  134.             else
  135.               state:=0;            {reset state machine}
  136.           end;
  137.       13: begin;    {receive data & write into rx buffer}
  138.             if (char_ind < dc_buffer_size) and (ch_code <> etx) then
  139.               begin; {buffer not full and not etx received}
  140.                 rx_buffer[rx_buff_wptr].data[char_ind]:=ch_code;
  141.                 bcc:=bcc xor ch_code; {bcc calculation}
  142.                 char_ind:=succ(char_ind); {increase buffer index}
  143.               end
  144.             else
  145.             if ch_code = etx then  {etx received}
  146.               begin;
  147.                 bcc:=bcc xor etx;  {get final bcc}
  148.                 rx_buffer[rx_buff_wptr].len:=char_ind - 1;
  149.                 state:=14;
  150.               end
  151.             else          {rx buffer overflow}
  152.               begin;
  153.                 state:=0; {reset state machine}
  154.                 rx_buffer_overflow:=true; {set flag}
  155.               end;
  156.           end;
  157.       14: begin;
  158.             if ch_code = bcc then  {received = calculated bcc}
  159.               begin;
  160.                 send_char(ack,ok); {send an ACK}
  161.                 if ok then {successfully sent, next rx buffer}
  162.                   rx_buff_wptr:=succ(rx_buff_wptr) mod rx_buffers
  163.                 else
  164.                   rx_buffer[rx_buff_wptr].len:=0;{forget rx data}
  165.               end
  166.             else                    {bcc error}
  167.               begin;
  168.                 rx_buffer[rx_buff_wptr].len:=0;{forget rx data}
  169.                 send_char(nak,ok); {send nak}
  170.               end;
  171.             state:=0;     {reset state machine}
  172.           end;
  173.       15: if ch_code = soh then state:=16 else state:=0; {FSL}
  174.       16: if ch_code = dc_addr_1 then state:=17 else state:=0;
  175.       17: if ch_code = dc_addr_2 then state:=18 else state:=0;
  176.       18: begin;
  177.             if ch_code = stx then  {stx received}
  178.               begin;
  179.                 if rx_buffer[rx_buff_wptr].len > 0 then
  180.                   state:=0    {no rx buffer available}
  181.                 else
  182.                   begin;      {start bcc calculation}
  183.                     bcc:=stx xor head_bcc;
  184.                     char_ind:=1; {init buff index}
  185.                     state:=13;   {wait for rx data}
  186.                   end;
  187.               end
  188.             else
  189.               state:=0;      {reset state machine}
  190.           end;
  191.        else state:=0;  {reset state machine}
  192.       end; {end case}
  193.       If ch_code = eot then state:=1; {preset state machine}
  194.     end;
  195.   end;
  196.  
  197.  
  198. Procedure clear_rx_buffers;  {clear all rx buffers}
  199. var
  200.   x:integer;
  201. begin;
  202.   for x:=0 to rx_buffers do
  203.     rx_buffer[x].len:=0;    {set length to 0}
  204.   rx_buff_wptr:=0;          {both pointers to 0}
  205.   rx_buff_rptr:=0;
  206. end;
  207.  
  208. Procedure clear_tx_buffers; {clear all xmit buffers}
  209. var
  210.   x:integer;
  211. begin;
  212.   for x:=0 to tx_buffers do
  213.     tx_buffer[x].len:=0;   {set length to 0}
  214.   tx_buff_wptr:=0;         {set both pointers to 0}
  215.   tx_buff_rptr:=0;
  216. end;
  217.  
  218.  
  219. Procedure init_ps;         {init poll select system}
  220. var
  221.   stat:integer;
  222. begin;
  223.   rx_buffer_overflow:=false;
  224.   cont_string:=chr(dc_addr_1) + chr(dc_addr_2)
  225.               + chr(pol) + chr(enq);  {set up contention string}
  226.   dc_msg_header:=chr(soh)+chr(dc_addr_1)+chr(dc_addr_2); {header}
  227.   head_bcc:=dc_addr_1 xor dc_addr_2;  {calculate bcc for header}
  228.   state:=0;             {reset state machine}
  229.   clear_rx_buffers;     {clear rx buffers}
  230.   clear_tx_buffers;     {clear tx buffers}
  231.   this_char_done:=true;
  232.   open_dc(stat);        {open datacom & install ISR}
  233.   send_string(cont_string,result_ok); {send contention string}
  234. end;
  235.  
  236. function data_received:boolean;  {returns true if at least one }
  237. begin;         {of the rx buffers contains data}
  238.   data_received:= rx_buffer[rx_buff_rptr].len > 0;
  239. end;
  240.  
  241. function dc_write_ok:boolean;  {returns true if at least one}
  242. begin;            {of the tx buffers is available}
  243.   dc_write_ok:=tx_buffer[tx_buff_wptr].len = 0;
  244. end;
  245.  
  246.  
  247. procedure  read_DC(var data;var len:integer;var ok:boolean);
  248. begin;  {call this routine to obtain data received from Mainframe}
  249.   if data_received then {one of the rx buffers contains data}
  250.     begin;              {return it}
  251.       len:=rx_buffer[rx_buff_rptr].len;
  252.       move(rx_buffer[rx_buff_rptr].data,data,len);
  253.       rx_buffer[rx_buff_rptr].len:=0; {clear this buffer}
  254.       rx_buff_rptr:=succ(rx_buff_rptr) mod rx_buffers; {incr pointer}
  255.       ok:=true;
  256.     end
  257.   else
  258.     ok:=false;       {no rx data available}
  259. end;
  260.  
  261. procedure  write_dc(var buff; len:integer;var ok:boolean);
  262. begin;  {call this routine to send data to mainframe}
  263.   if dc_write_ok then  {tx buffer available}
  264.     begin;
  265.       move(buff,tx_buffer[tx_buff_wptr].data,sizeof(buff));
  266.       tx_buffer[tx_buff_wptr].len:=len;
  267.       tx_buff_wptr:=succ(tx_buff_wptr) mod tx_buffers;
  268.       ok:=true;
  269.     end
  270.   else
  271.     ok:=false;        {no tx buffer available}
  272. end;
  273.  
  274.